home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / biz / swood / FWTabTools.lha / FWTabTools / FWCalcTab.rexx < prev    next >
OS/2 REXX Batch file  |  1997-11-11  |  14KB  |  624 lines
  1. /* $VER: 0.17 beta, (11.11.1997), © by Thorsten Willert
  2.  
  3.    Macro um einer FinalWriter-Tabellen
  4.    die GRUNDfunktionen einer
  5.    Tabellenkalkulation beizubringen.
  6.  
  7. -----------------------------------------------*/
  8.  
  9. ADDRESS = 'FinaW'
  10. OPTIONS CACHE RESULTS
  11.  
  12. STATUS PORTNAME
  13. FW = RESULT
  14. ADDRESS = FW
  15.  
  16. SIGNAL ON BREAK_C
  17. SIGNAL ON HALT
  18. SIGNAL ON SYNTAX
  19.  
  20. /*-----------------------------------------------*/
  21.  
  22. IF ~show('L',"rexxreqtools.library") THEN DO
  23.    IF ~addlib('rexxreqtools.library',0,-30,0) THEN DO
  24.       'ShowMessage 1 1 "Error ..." "Missing rexxreqtools.library!" "" "Cancel !!" "" ""'
  25.       EXIT 20
  26.    END
  27. END
  28.  
  29. /*------------- Initialisierung -----------------*/
  30.  
  31. RT.Version = "0.17 beta"
  32. RT.R       = '0A'X
  33. RT.Title   = "FWCalc, "|| RT.Version 
  34. RT.Para1   = "rtez_flags = ezreqf_centertext"
  35. RT.Para2   = "rt_pubscrname = FinalWriterPubScreen rtfi_flags = freqf_selectdirs"
  36. RT.Copyright  = RT.Title || ", © 1997, by Thorsten Willert"
  37.  
  38. R          = '0A'X
  39. Zahlen     = "1234567890.,-"
  40. FormelZ    = "ABCDEFGHIJKLMNOPQRSTUVWXYZ+-*/%"
  41.  
  42. Datei.TMP  = "T:FWCalc_Formeln.TMP"
  43. Datei.TMP2 = "T:FWCalc_Formeln.TMP2"
  44. Datei.TMP3 = "T:FWCalc_Formeln.TMP3"
  45. Datei.TMP4 = "T:FWCalc_Formeln.TMP4"
  46.  
  47. Text.5     = "_Exit"
  48. Text.8     = "  User break!  "
  49. Text.9     = "Syntax Error!"
  50. Message.100 = "Could not open FWCalc.catalog!"
  51.  
  52. /*--------------- Hauptprogramm ------------------*/
  53.  
  54. CALL Locale
  55.  
  56. Info = 1
  57. IF Info = 1 THEN CALL Info
  58.  
  59. DO FOREVER
  60.     Commando = rtezrequest(Text.1,Text.2,RT.Title)
  61.     CALL DocInfos
  62.     FormelDatei = RESULT
  63.     
  64.     IF EXISTS( FormelDatei ) THEN ADDRESS command 'C:COPY ' FormelDatei 'TO' Datei.TMP2
  65.         ELSE CALL Message( 4 )            
  66.     
  67.     IF TableDimension() = 1 THEN
  68.         DO    
  69.             TabellenName = GetTabName()
  70.             CALL SelectFormeln( TabellenName )
  71.                 SELECT
  72.                     WHEN Commando = 1 THEN 
  73.                         DO
  74.                             Modus = "CALC"
  75.                             CALL GetInhalt
  76.                             CALL Calc   
  77.                         END    
  78.                     WHEN Commando = 2 THEN CALL FormelEditor
  79.                     /* WHEN Commando = 3 THEN
  80.                         DO
  81.                             CALL RemoveCoordinaten
  82.                         END */
  83.                     OTHERWISE CALL Ende
  84.                 END            
  85.             CALL Clear 
  86.         END
  87.     
  88. END   
  89.  
  90. /*----------------- Ende -------------------------*/
  91.  
  92. Ende:
  93.  
  94. IF Coordinaten = 1 THEN CALL RemoveCoordinaten
  95. CALL Clear
  96.  
  97. EXIT
  98.  
  99. /*------------ Unterprogramme --------------------*/
  100.  
  101. Locale: PROCEDURE EXPOSE Message. Text. RT. R
  102.  
  103. CatalogOK = 0
  104.  
  105. IF EXISTS("ENV:Language") THEN 
  106.     IF OPEN( Datei , "ENV:Language", "R" ) THEN Sprache = READLN( Datei )
  107. ELSE
  108.     Sprache = english
  109.  
  110. IF EXISTS("Locale:Catalogs/" || Sprache || "/FWCalcTab.catalog") THEN CatalogOK =  ReadCatalog( Sprache )
  111.     ELSE IF EXISTS("Locale:Catalogs/english/FWCalcTab.catalog") THEN CatalogOK =  ReadCatalog( "english" )
  112.  
  113. IF CatalogOK = 0 THEN 
  114.     DO
  115.         CALL Message( 100 )
  116.         CALL Ende
  117.     END
  118.  
  119. RETURN
  120.  
  121. /*------------------------------------------------*/
  122.  
  123. ReadCatalog: PROCEDURE EXPOSE Message. Text. RT. R
  124. PARSE ARG Sprache
  125.  
  126. IF OPEN( Locale, "Locale:Catalogs/" || Sprache || "/FWCalcTab.catalog" , "R") THEN
  127.         DO WHILE ~EOF( Locale )
  128.             InZeile = READLN( Locale )
  129.             INTERPRET( InZeile )
  130.         END
  131.         
  132. RETURN OffenDatei
  133.  
  134. /*------------------------------------------------*/
  135.  
  136. FormelEditor:
  137.  
  138. Save = 1
  139. Modus = "FORMEL"
  140.  
  141. Coordinaten = InsertCoordinaten()
  142. CALL ViewFormel
  143.  
  144. IF ~EXISTS( Datei.TMP4 ) THEN OPEN( Datei1 , Datei.TMP4 , "W" )
  145. CLOSE( Datei1 )
  146.  
  147.     DO FOREVER
  148.         rtezrequest(Text.3,Text.4,RT.Title)                    
  149.          
  150.             IF rtresult == 1 THEN LEAVE        
  151.             ELSE LEAVE
  152.     END
  153.  
  154. CALL GetInhalt
  155. CALL CALC
  156.  
  157.  
  158. ADDRESS command 'C:join' Datei.TMP4 Datei.TMP3 'TO ' FormelDatei
  159. IF RC=20 THEN
  160.         /*DO
  161.             OPEN( Datei , Datei.TMP4 , "W")
  162.             WRITELN( Datei , "  " )
  163.             CLOSE( Datei )
  164.             ADDRESS command 'C:join' Datei.TMP4 Datei.TMP3 'TO ' FormelDatei*/
  165.             
  166.             ADDRESS command 'C:copy' Datei.TMP3 'TO ' FormelDatei
  167.  
  168.      
  169. ADDRESS command 'C:delete ' Datei.TMP4
  170.  
  171. IF Coordinaten = 1 THEN CALL RemoveCoordinaten
  172.  
  173. Save = 0
  174.                
  175. RETURN
  176.  
  177. /*-----------------------------------------------*/
  178.  
  179. DocInfos: PROCEDURE EXPOSE FW Message. RT. Text.
  180.  
  181. ADDRESS (FW)
  182.  
  183. STATUS PathName
  184. Path = RESULT
  185.     IF Path = "" THEN 
  186.         DO FOREVER
  187.             CALL Message( 6 )
  188.             SaveAs
  189.             IF RC=0 THEN LEAVE
  190.         END
  191.  
  192. FormelDatei = Path || ".CALC"
  193.     
  194. RETURN FormelDatei
  195.  
  196. /*-----------------------------------------------*/
  197.  
  198. GetTabName: PROCEDURE EXPOSE RT. Message. Text.
  199.  
  200. DO FOREVER
  201.     GetObjectTitle
  202.     TabellenName = RESULT
  203.       
  204.     IF LENGTH( TabellenName ) >= 2 THEN
  205.     DO 
  206.         TabellenName = TRANSLATE( TabellenName ,"_", " " )
  207.         LEAVE
  208.     END
  209.     ELSE 
  210.     DO
  211.         CALL Message( 2 )
  212.         TablePrefs Prompt
  213.     END                   
  214. END
  215.  
  216. RETURN TabellenName
  217.  
  218. /*-----------------------------------------------*/
  219.  
  220. SelectFormeln: PROCEDURE EXPOSE Datei.
  221. PARSE ARG Tabelle
  222.  
  223. IF EXISTS( Datei.TMP2 ) THEN
  224.     DO
  225.         OPEN( Datei1, Datei.TMP2, "R" )
  226.         OPEN( Datei2, Datei.TMP , "W" )
  227.         OPEN( Datei3, Datei.TMP3, "W" )
  228.     
  229.         DO WHILE ~EOF( Datei1 )
  230.             InZeile = READLN( Datei1 )
  231.             IF InZeile = "" THEN ITERATE
  232.             IF SUBWORD( InZeile ,1,1 ) = Tabelle THEN WRITELN( Datei2, InZeile )
  233.                 ELSE WRITELN( Datei3, InZeile )
  234.         END
  235.     
  236.         CLOSE( Datei1 )
  237.         CLOSE( Datei2 )
  238.         CLOSE( Datei3 )            
  239.     END
  240.     
  241. RETURN
  242.  
  243. /*-----------------------------------------------*/
  244.  
  245. TableDimension: PROCEDURE EXPOSE Spalten Zeilen FW Message. RT. Text.
  246.  
  247. TableOK = 1
  248.  
  249. ADDRESS(FW)
  250. TableGetColumns 
  251.     PARSE VAR RESULT Muell Spalten
  252.  
  253. TableGetRows
  254.     PARSE VAR RESULT Muell Zeilen
  255.  
  256. IF Zeilen = "" | Spalten = "" THEN /* Geht nicht über GetObjektType */
  257.     DO
  258.         CALL Message( 1 )
  259.         TableOK = 0
  260.     END
  261.  
  262. RETURN TableOK
  263.  
  264. /*-----------------------------------------------*/
  265.  
  266. InsertCoordinaten: PROCEDURE EXPOSE Zeilen Spalten FW
  267.  
  268. ADDRESS(FW)
  269. TableInsertRows 2 1
  270. Redraw
  271.  
  272. TableInsertColumns 2 1 1
  273. Redraw
  274.  
  275. i = 0
  276. j = 0
  277.  
  278. DO WHILE i ~= Zeilen - 1
  279.     i = i + 1
  280.     Zeile = i + 2
  281.     TableSetActiveCell Zeile 2
  282.     Justify Center
  283.     Type i
  284. END
  285.  
  286. DO WHILE j ~= Spalten - 1 | j = 26
  287.     j = j + 1
  288.     Spalte = j + 2
  289.     TableSetActiveCell 2 Spalte
  290.     ABC = D2C( 64 + j )
  291.     Justify Center
  292.     Type ABC
  293. END
  294.  
  295. Coordinaten = 1
  296.  
  297. RETURN Coordinaten
  298.  
  299. /*-----------------------------------------------*/
  300.  
  301. RemoveCoordinaten:
  302.  
  303. TableDeleteColumns 2 1 Force;TableDeleteRows 2 1 Force
  304. Coordinaten = 0
  305.  
  306. RETURN
  307.  
  308. /*--------- Tabellen Inhalt einlesen -----------*/
  309.  
  310. GetInhalt:
  311.  
  312. ADDRESS (FW)
  313.  
  314. GetDocItemPrefs Decimal
  315. Punkt = result
  316. result = ""
  317.  
  318. NN=0;s=0
  319.  
  320. DO FOREVER
  321.     z=0
  322.     IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
  323.         ELSE TableSetActiveCell z+3 s+3
  324.         
  325.     SpaltenName=D2C(65+s)
  326.         DO FOREVER
  327.             IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
  328.                 ELSE TableSetActiveCell z+3 s+3
  329.             SelectAll
  330.             Extract
  331.             ZellenInhalt=COMPRESS(RESULT,'09'X'0A'X)
  332.             IF DATATYPE( ZellenInhalt , Numeric ) THEN Justify Right
  333.                 ELSE
  334.                     DO
  335.                         ZellenInhalt2=0
  336.                         IF Save = 1 THEN SaveFormel( ZellenInhalt )
  337.                         IF RESULT = 0 THEN RETURN 
  338.                     END
  339.             
  340.             ZeilenNummer=z+1
  341.             
  342.             IF Modus ~= "FORMEL" THEN TableSetActiveCell z+2 s+2
  343.                 ELSE TableSetActiveCell z+3 s+3
  344.             SelectAll
  345.             Clear
  346.             
  347.             ZellenInhalt2=TRANSLATE(ZellenInhalt,"." ,",")     
  348.             Type ZellenInhalt2
  349.                 
  350.             IF ZellenInhalt = "" THEN ZellenInhalt2 = 0
  351.             ZellenInhalt2 = COMPRESS(ZellenInhalt2,"+-/%&|():*")
  352.             
  353.             INTERPRET(SpaltenName||ZeilenNummer"="ZellenInhalt2)
  354.             z=z+1
  355.             
  356.             IF z=Zeilen-1 THEN LEAVE
  357.         END
  358.     s=s+1
  359.     IF s=Spalten-1 THEN LEAVE
  360. END
  361.     
  362. RETURN
  363.  
  364. /*----------- Formeln berechenen  --------------*/
  365.  
  366. Berechnen:
  367.  
  368. ErgebnisOK = 0
  369.  
  370. IF FormelOK = 1 THEN
  371.     DO
  372.     ErgebnisOK = 1
  373.         SELECT
  374.             WHEN Rechnung = "DURCHSCHNITT" THEN
  375.                 DO
  376.                     Formel3 = STRIP(TRANSLATE( Formel2 , " ", "+-/;*" ))
  377.                     Operanden = WORDS( Formel3 )
  378.                     Formel2 = TRANSLATE( "(" || Formel3 , "+" , " ") || ")/" || Operanden
  379.                     CALL Ausgabe
  380.                     ErgebnisOK = 1
  381.                 END
  382.             WHEN Rechnung = "SUMME" THEN
  383.                 DO
  384.                     CALL Ausgabe
  385.                     ErgebnisOK = 1
  386.                 END
  387.             WHEN Rechnung = "DATE" THEN CALL UpDate
  388.             WHEN Rechnung = "TIME" THEN CALL UpDateTime
  389.             OTHERWISE NOP 
  390.          END
  391.     END
  392.                      
  393. RETURN ErgebnisOK
  394.  
  395. /*--------- Ergebnis ausgeben -------------------*/
  396.  
  397. Ausgabe:
  398.  
  399. INTERPRET("Ergebnis =" Formel2 )
  400. IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
  401.     ELSE TableSetActiveCell ZeileA+2 SpalteA+2
  402.     
  403. SelectAll;Clear;FontColor Schwarz;Style Bold;Justify Right;Type Ergebnis
  404.  
  405. RETURN
  406.  
  407. /*--------------------------------------------*/
  408.  
  409. UpDate:
  410.  
  411. ADDRESS(FW)
  412. IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
  413.     ELSE TableSetActiveCell ZeileA+2 SpalteA+2
  414.  
  415. SelectAll;Clear;Justify Left;FontColor Schwarz;Insert Date
  416.  
  417. RETURN
  418.  
  419. /*--------------------------------------------*/
  420.  
  421. UpDateTime: 
  422.  
  423. ADDRESS(FW)
  424. IF Modus = "CALC" THEN  TableSetActiveCell ZeileA+1 SpalteA+1
  425.     ELSE TableSetActiveCell ZeileA+2 SpalteA+2
  426.  
  427. SelectAll;Clear;Justify Right;FontColor Schwarz;Insert Time
  428.  
  429. RETURN
  430.  
  431. /*--------------------------------------------*/
  432.  
  433. FormelInterpreter:
  434. PARSE ARG FORMEL
  435.  
  436. FormelOK  = 0
  437. SpalteA   = 0
  438. ZeileA    = 0
  439.  
  440. Formel = UPPER(STRIP( Formel ))
  441. BeginnFormel = POS( "=" , Formel )
  442.  
  443. IF BeginnFormel ~= 0 THEN
  444.     DO
  445.         ErgebnisZelle = SUBSTR( Formel , 1 , BeginnFormel -1  )
  446.         
  447.         SpalteA = C2D( SUBSTR( ErgebnisZelle , 1 , 1)) - 64
  448.         ZeileA = STRIP(SUBSTR( ErgebnisZelle , 2))
  449.          
  450.         SELECT
  451.             WHEN POS( "=(" , Formel ) ~= 0 THEN
  452.                 DO
  453.                     Formel2 = StripFormel( Formel )
  454.                     Rechnung = "SUMME"
  455.                 END
  456.             WHEN POS( "=DURCHSCHNITT" , Formel ) ~=0 THEN
  457.                 DO
  458.                     Formel2 =  StripFormel( Formel )
  459.                     Rechnung = "DURCHSCHNITT"
  460.                 END
  461.             WHEN POS( "=DATE", Formel ) ~=0 THEN Rechnung = "DATE"
  462.             WHEN POS( "=TIME", Formel) ~= 0 THEN Rechnung = "TIME"
  463.             OTHERWISE RETURN FormelOK
  464.         END
  465.             
  466.         IF VERIFY( Formel , FormelZ ) ~= 0 THEN FormelOK = 1
  467.                 
  468.     END
  469.  
  470. RETURN FormelOK
  471.  
  472. /*-------------------------------------------*/
  473.  
  474. StripFormel: 
  475. PARSE ARG FormelS
  476.  
  477.     FirstPos = POS( '(', FormelS )
  478.     LastPos = LASTPOS( ')' , FormelS )
  479.     FormelS = DELSTR( FormelS , LastPos )
  480.     
  481.     Formel2 = SUBSTR( FormelS , FirstPos + 1)
  482.     
  483. RETURN Formel2
  484.  
  485. /*-------------------------------------------*/
  486.  
  487. Calc:
  488.  
  489. KF = 1
  490.  
  491. IF EXISTS( Datei.TMP4 ) THEN Datei = Datei.TMP4
  492.     ELSE Datei = Datei.TMP 
  493.  
  494. IF EXISTS( Datei ) THEN
  495.     DO
  496.         OffenDatei2 = OPEN( Datei2, Datei, "R" )
  497.         DO WHILE ~EOF( Datei2 )
  498.             InZeile =  READLN( Datei2 )
  499.             IF InZeile = "" THEN LEAVE
  500.             PARSE VAR InZeile TabellenNameD Formel
  501.             IF TabellenNameD ~= TabellenName THEN ITERATE
  502.             KF = 0 
  503.             IF FormelInterpreter( Formel ) = 0 THEN RETURN
  504.             CALL Berechnen
  505.          END   
  506.     END
  507.  
  508. CLOSE( Datei2 )
  509.  
  510. IF KF = 1 & Save = 0 THEN CALL Message( 3 )
  511.  
  512. RETURN
  513.  
  514. /*--------------------------------------------*/
  515.  
  516. ViewFormel:
  517.  
  518. IF EXISTS( Datei.TMP ) THEN
  519.     DO
  520.         OffenDatei2 = OPEN( Datei2, Datei.TMP, "R" )
  521.         DO WHILE ~EOF( Datei2 )
  522.  
  523.             InZeile = READLN( Datei2 )
  524.             PARSE VAR InZeile TabellenNameD Formel
  525.             
  526.             CALL FormelInterpreter( Formel )
  527.             
  528.             TableSetActiveCell ZeileA+2 SpalteA+2
  529.                 SelectAll
  530.                 Clear
  531.                 Justify Left
  532.                 FontColor Rot
  533.                 Style Normal
  534.                 Type Formel
  535.         END
  536.         CLOSE( Datei2 )
  537.     END
  538.  
  539. RETURN
  540.  
  541. /*--------------------------------------------*/
  542.  
  543. SaveFormel: PROCEDURE EXPOSE Datei. RT. Text. Message. FW FormelZ Save
  544. PARSE ARG Formel
  545.  
  546. SaveFormelOK = 0
  547.  
  548. STATUS PathName
  549. FormelDatei=RESULT||".CALC"
  550.  
  551. IF FormelInterpreter( Formel ) = 0 THEN RETURN SaveFormelOK
  552.         
  553. CALL GetTabName
  554. TabellenName = RESULT
  555.  
  556. IF OPEN( Datei1, Datei.TMP4, "A" ) = 1 THEN
  557.     DO
  558.         WRITELN(Datei1, TabellenName Formel )
  559.         SaveFormelOK = 1
  560.     END
  561. CLOSE( Datei1 )
  562.     
  563. RETURN SaveFormelOK
  564.  
  565. /*----------------------------------------------*/
  566.  
  567. Info: PROCEDURE EXPOSE RT. Text.
  568.  
  569.     rtezrequest(Text.7,Text.5,RT.Title)
  570.  
  571. RETURN
  572.  
  573. /*-----------------------------------------------*/
  574.  
  575. Message: EXPOSE Message. RT. Text.
  576. PARSE ARG Index
  577.  
  578. IF Index <= 100 THEN rtezrequest(Message.Index,Text.5,RT.Title)
  579.     ELSE
  580.         DO FOREVER
  581.             IF rtezrequest(Message.Index,Text.6,RT.Title) == 1 THEN LEAVE
  582.                 ELSE CALL Info
  583.         END
  584.  
  585. RETURN
  586.  
  587. /*----------------------------------------------*/
  588.  
  589. Clear:
  590.  
  591. CLOSE( Datei  )
  592. CLOSE( Datei1 )
  593. CLOSE( Datei2 )
  594. CLOSE( Datei3 )
  595. CLOSE( Datei4 )
  596.  
  597. ADDRESS command 'C:delete ' Datei.TMP
  598. ADDRESS command 'C:delete ' Datei.TMP2
  599. ADDRESS command 'C:delete ' Datei.TMP3
  600. ADDRESS command 'C:delete ' Datei.TMP4
  601.  
  602. RETURN
  603.  
  604. /*----------------------------------------------*/
  605.  
  606. HALT:
  607. BREAK_C:
  608.  
  609. rtezrequest(Text.8,Text.5,RT.Title)
  610.  
  611. CALL Ende
  612.  
  613. RETURN
  614.  
  615. /*---------------------------------------------*/
  616.  
  617. SYNTAX:
  618.  
  619. rtezrequest(Text.9,Text.5,RT.Title)
  620.  
  621. CALL Ende
  622.  
  623. RETURN
  624.